package XNAT::DICOM::Session;
@ISA = ('XNAT::DICOM::Entity');

use strict;
use Carp qw(croak carp cluck confess);
use Cwd qw( abs_path getcwd );

require XNAT::DICOM::File;
require XNAT::DICOM::Series;

# Used to keep track of objects.
my %loaded_by_uid;
my %loaded_by_label;

my ($prog,$progdir);
if($0 =~ m{(.*)/(.*?)$}) {
	($progdir,$prog) = ($1,$2);
} else {
	($progdir,$prog) = ($0,'');
}
$progdir = '.' unless $progdir;

# Which DICOM Headers have to be the same across the Session?
my $immutable_headers =
  {
	 NumberOfStudyRelatedInc => 1,
	 NumberOfStudyRelatedSeries => 1,
   DeviceSerialNumber => 1,
   ExifToolVersion => 1,
   InstitutionAddress => 1,
   InstitutionName => 1,
   MRReceiveCoilSequence => 1,
   MRTransmitCoilSequence => 1,
   MagneticFieldStrength => 1,
   Manufacturer => 1,
   ManufacturersModelName => 1,
   Modality => 1,
   MultiCoilConfiguration => 1,
   MultiCoilDefinitionSequence => 1,
   MultiCoilElementName => 1,
   MultiCoilElementUsed => 1,
   OperatorsName => 1,
   PatientID => 1,
   PatientsAge => 1,
   PatientsBirthDate => 1,
   PatientsName => 1,
   PatientsSex => 1,
   PatientsWeight => 1,
   PerformedProcedureStepDescription => 1,
   PerformedProcedureStepID => 1,
   PerformingPhysiciansName => 1,
   QuadratureReceiveCoil => 1,
   ReceiveCoilManufacturerName => 1,
   ReceiveCoilName => 1,
   ReceiveCoilType => 1,
   ReferringPhysiciansName => 1,
   RequestedProcedureDescription => 1,
   SoftwareVersion => 1,
   SpecificCharacterSet => 1,
   StationName => 1,
   StudyDate => 1,
   StudyDescription => 1,
   StudyID => 1,
   StudyInstanceUID => 1,
   StudyTime => 1,
   TransmitCoilManufacturerName => 1,
   TransmitCoilName => 1,
   TransmitCoilType => 1,
	 XNATPreArchiveDirectory => 1,
  };

=head1 XNAT::DICOM::Session

XNAT::DICOM::Session - an collection of MRI Scans ( XNAT::DICOM::File objects, really ) that constitute a scan session.

=head2 STATIC METHODS

=over 4

=item XNAT::DICOM::Session::getAll();

Get all sessions ever instatiated with this class (during the current script's execution, of course).

=cut

sub getAll { shift if ref $_[0]; values %loaded_by_uid; }

=item XNAT::DICOM::Session::getByUid($uid);

Get a session by its DICOM UID as defined in the 'InstanceNumber' DICOM Header.
Returns undef if it has not been loaded or does not exist.

=cut

sub getByUid { shift if ref $_[0]; $loaded_by_uid{shift(@_)}; }

=item XNAT::DICOM::Session::getById($id);

Get a session by its Internal ID as defined by

 "${XNAT_label}"

which is the same as

 "${DICOM_PatientsName}"

Without any whitespace. Returns undef if it has not been loaded or does not exist.

=cut

sub getById { shift if ref $_[0]; $loaded_by_label{shift(@_)}; }

sub _addLoaded {
  my $self = shift || confess "Wrong number of args. ";
	my $uid = $self->{uid};
	my $label = $self->{label};
  my $errors = "";
  $errors .=  "ERROR: Session UID '$uid' already Exists.\n" if $loaded_by_uid{$uid};
  $errors .=  "ERROR: Session Internal ID '$label' already Exists.\n" if $loaded_by_label{$label};
  confess $errors if $errors;
  $loaded_by_uid{$uid} = $self;
  $loaded_by_label{$label} = $self;
}

=back

=cut

=head2 INSTANCE METHODS

=over 4

=cut


sub new {
  my $class = shift;
  my $self = {series=>{},series_count=>0,size_on_disk=>0,uncompressed_size=>0,};
  bless $self,$class;
  confess "Wrong number of args." unless @_ == 1;
  if('XNAT::DICOM::File' eq ref $_[0]) {
    my $file = shift;
    $self->{PatientsName} = $file->getHeader('PatientsName') || confess "Missing PatientsName DICOM Header!";
    $self->{uid} = $file->getHeader('StudyInstanceUID') || confess "Missing StudyInstanceUID DICOM Header!";
  } else {
    confess "Did not understand arguments!\n";
  }
  $self->{label} = $self->{PatientsName};
  # remove whitespace.
  $self->{label} =~ s/\s+//g;
	if($main::verbose > 3) {
		$self->debug(3,"XNAT::DICOM::Session->new(): label  = '$self->{label}'\n");
		$self->debug(3,"XNAT::DICOM::Session->new(): PatientsName = '$self->{PatientsName}'\n");
		$self->debug(3,"XNAT::DICOM::Session->new(): uid          = '$self->{uid}'\n");
	}
  if( getById($self->{label}) ) {
		$self->debug(3,"XNAT::DICOM::Session->new(): Already Loaded, returning previous object.\n");
    $self = getById( $self->{label} );
  } else {
		$self->debug(2,"XNAT::DICOM::Session->new(): label  = '$self->{label}' created.\n");
    if($self->{label} ne $self->{PatientsName}) {
      $self->addWarnings("DICOM Header PatientsName='$self->{PatientsName}' contained whitespace.");
    }
    $self->_addLoaded($self);
  }
  # Remember to return the $self at the end!
  $self;
}

=item $series->addSeries($series)

Add a XNAT::DICOM::Series object to this session.

=cut


sub addSeries {
  my $self = shift;
  my $series = shift;
  if($self->{series}->{$series->{series_number}}) {
    # ignore
		$self->debug(3,"IGNORED adding Series '$series->{label}' to Session '$self->{label}'.\n");
  } else {
    $self->{series}->{$series->{series_number}} = $series;
    $self->{_headers_checked} = 0;
		$self->{series_count}++;
		$self->debug(1,"Adding Series '$series->{label}' to Session '$self->{label}'.\n");
		$self->addChild($series);
  }
}

sub _set_need_to_update { $_[0]->{need_to_update} = 1; }
sub _unset_need_to_update { $_[0]->{need_to_update} = 0; }
sub _get_need_to_update { $_[0]->{need_to_update}; }

=item $session->getSortedSeries()

Get the XNAT::DICOM::Series objects that make up this Session, in numerical order.
This is slower than $session->getSeries(), but much more logical. Use when outputting
for humans.

=cut

sub getSortedSeries {
  my $self = shift;
  my @series;
  foreach my $series_number (sort keys %{$self->{series}}) {
    push @series,$self->{series}->{$series_number};
  }
  @series;
}

=item $session->getSeries()

Get the XNAT::DICOM::Series objects that make up this Session, in no particular order.
This is faster than in sorted order.

=cut

sub getSeries { values %{$_[0]->{series}}; }

=item $session->getHeader($header)

Get the common DICOM header value for this session. Returns value, 'Several', if there are more than one, or undef.

=cut

sub getHeader { my($self,$header) = @_;$self->{headers}->{$header}; }


=item $session->getHeader($header)

Get the common DICOM header value for this session. Will set it to 'Several', if there are more than one.

=cut

sub setHeader {
	my($self,$header,$value,$xtra) = @_;
	if($xtra) {
		confess "ERROR: Wrong numbre of arguments!\n";
	}
	if( exists $self->{headers}->{$header} && $self->{headers}->{$header} ne $value) {
		$self->{headers}->{$header} = 'Several';
	} else {
		$self->{headers}->{$header} = $value;
	}
}

=item $session->checkHeaders()

Check and see that the headers are OK.

=cut

sub checkHeaders {
  my $self = shift;
  if (! $self->{_headers_checked}) {
    foreach my $series ($self->getSeries) {
      my @dicoms = $series->getDicomFiles();
      my @headers = sort keys %{$immutable_headers};
      $self->{headers} = {};
      foreach my $header ( @headers ) {
				foreach my $dicom ( @dicoms ) {
					my $this_header_value = $dicom->getHeader($header);
					if (! defined $this_header_value ) {
						$this_header_value = '';
					}
					if (exists $self->{headers}->{$header} && $self->getHeader($header) ne '') {
						if ($self->getHeader($header) ne $this_header_value) {
							$self->addWarnings("Header $header with value of '$this_header_value' does not match previously read ".
																 "value of '".$self->getHeader($header)."'.\n");
						}
					} else {
						$self->setHeader($header,$this_header_value);
					}
				}
      }
    }
  }
}

sub check {
	my $self = shift;
	$self->checkHeaders;
	print "Session: $self->{label} Number of Series = '$self->{series_count}'\n";
	$self->{xml_file} = $self->{label}.'.xml';
	$self->{investigator} = "undef";
	if ($self->getHeader('StudyDescription') =~ m/(.*)(INVESTIGATORS)\^(\s*)(\S.*)$/i) {
		$self->{investigator} = $4;
		if ($1 or $3 or $self->{investigator} =~ s/\s+//g) {
			$self->addWarnings("DICOM Header StudyDescription should be of the form 'INVESTIGATORS^Investigator_Name' without spaces where Investigator_Name is the name of the PI. It was '".$self->getHeader('StudyDescription')."' instead.");
		} else {
			$self->{headers}->{XNATStudyDirectory} = $2.'_'.$self->{investigator};
		}
	}
	$self->{pi} = defined $self->getHeader('PI') ? $self->getHeader('PI') : 'undef';
	if($self->getHeader('PI')) {
		if (lc($self->{pi}) ne lc($self->{investigator})) {
			$self->addWarnings(
												 "DICOM Header PI='$self->{pi}' does not match investigator '$self->{investigator}' in DICOM Header StudyDescription."
												);
		}
	}
	if ($self->{label} !~ m/^\d\d\d\d\d\d_/) {
		$self->addWarnings(
											 "DICOM Header PatientsName should contain the session_id begining with the scandate (e.g. '090717_FOO')".
											 " but it was '".$self->getHeader('PatientsName')."'.");
	}
	print $self->getErrors if $self->hadErrors;
	print $self->getWarnings if $self->hadWarnings;
	foreach my $series ($self->getSortedSeries) {
		# nothing for now.
		$series->check;
	}
}

sub asXML {
	my $self = shift;
	my $opts = shift;
	my $xml = "";
	my $datetime = localtime();
	print "Generating XML for '$self->{label}'\n" if $main::verbose > 0;
	$self->{Date} = $self->getHeader('StudyDate');
	$self->{Time} = $self->getHeader('StudyTime');
	$self->{Date} =~ s/:/-/g;
	$self->{Time} =~ s/\.\d+$//;
	$xml .= "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
	$xml .= "<xnat:MRSession xmlns:xnat=\"http://nrg.wustl.edu/xnat\"";
	$xml .= " xmlns:arc=\"http://nrg.wustl.edu/arc\"";
	$xml .= " xmlns:behavioral=\"http://nrg.wustl.edu/behavioral\"";
	$xml .= " xmlns:cat=\"http://nrg.wustl.edu/catalog\"";
	$xml .= " xmlns:cnda=\"http://nrg.wustl.edu/cnda\"";
	$xml .= " xmlns:fs=\"http://nrg.wustl.edu/fs\"";
	$xml .= " xmlns:kblack=\"http://nrg.wustl.edu/wu_kblack\"";
	$xml .= " xmlns:ls2=\"http://nrg.wustl.edu/ls2\"";
	$xml .= " xmlns:prov=\"http://www.nbirn.net/prov\"";
	$xml .= " xmlns:wrk=\"http://nrg.wustl.edu/workflow\"";
	$xml .= " xmlns:xdat=\"http://nrg.wustl.edu/security\"";
	$xml .= " xmlns:xnat_a=\"http://nrg.wustl.edu/xnat_assessments\"";
	$xml .= " xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"";
  #if($opts->{extended_output}) {
	#	$xml .= " ID=\"$self->{label}\"";
	#} else {
		$xml .= " ID=\"\"";
	#}
	$xml .= " UID=\"".$self->getHeader('StudyInstanceUID')."\"";
	$xml .= " modality=\"".$self->getHeader('Modality')."\"";
	$xml .= " session_type=\"".$self->getHeader('StudyDescription')."\">\n";
	$xml .= " <xnat:sharing><xnat:share project=\"null\" /></xnat:sharing><xnat:date>$self->{Date}</xnat:date>\n";
	$xml .= " <xnat:time>$self->{Time}</xnat:time>\n";
	#if($opts->{extended_output}) {
	#	$xml .= " <xnat:subject_ID>".$self->getHeader('PatientsName')."</xnat:subject_ID>\n";
	#} else {
		$xml .= " <xnat:subject_ID>INVALID: ".$self->getHeader('PatientsName')."</xnat:subject_ID>\n";
	#}
	if($opts->{extended_output}) {
		$xml .= " <xnat:scanner manufacturer=\"".$self->getHeader('Manufacturer')."\" model=\"".$self->getHeader('ManufacturersModelName')."\">".$self->getHeader('StationName')."</xnat:scanner>\n";
	} else {
		$xml .= " <xnat:scanner>".$self->getHeader('StationName')."</xnat:scanner>\n";
	}
	if($opts->{extended_output}) {
		$xml .= " <xnat:operator>".$self->getHeader('OperatorsName')."</xnat:operator>\n";
	}
	if( $self->getHeader('XNATPreArchiveDirectory') ) {
		$xml .= " <xnat:prearchivePath>".$self->getHeader('XNATPreArchiveDirectory')."</xnat:prearchivePath>\n";
	} else {
		$self->addErrors("Session->{prearchive_dir} is not defined!\n");
	}
	$xml .= " <xnat:scans>\n";
	foreach my $series ( $self->getSortedSeries ) {
		$xml .= $series->getSessionXML($opts);
	}
	$xml .= "  </xnat:scans>\n";
	$xml .= "  <xnat:dcmAccessionNumber />\n";
	$xml .= "  <xnat:dcmPatientId>".$self->getHeader('PatientID')."</xnat:dcmPatientId>\n";
	$xml .= "  <xnat:dcmPatientName>".$self->getHeader('PatientsName')."</xnat:dcmPatientName>\n";
	$xml .= "</xnat:MRSession>\n";
	if($opts->{extended_output}) {
		$xml .= "<!-- Generated by $prog (pid $$) on $datetime -->\n";
	}
	$xml;
}

=back

=cut

1;
__END__
